require(parallel)
df_sample<-read.csv("medium_train_sample.csv",stringsAsFactors=F)
num.tags<-3000

tag.freq <- table(unlist(strsplit(df_sample$Tags," ")))                    ##Get tag names and their frequency on the training data
tag.freq <- tag.freq[rev(order(tag.freq))]
tag.names <- names(tag.freq)
tag.map<-read.csv('tag_map.csv', header=T, stringsAsFactors=F)           ##tag_map.csv has regexps selected for top 300 tags
more.tags<-setdiff(tag.names[1:num.tags], tag.map$tag)
more.regexp<-gsub("-",".", more.tags,fixed=T)
more.regexp<-gsub("#","\\#", more.regexp,fixed=T)
more.regexp<-gsub("+","\\+", more.regexp,fixed=T)
tag.map<-rbind(tag.map, data.frame(tag=more.tags, regexp=more.regexp))
v.text <- tolower(paste(df_sample$Title, df_sample$Body, sep=" "))
v.title <- tolower(df_sample$Title)
v.text<-gsub("#","sharp",v.text, fixed=T,useByte=T)
v.text<-gsub("+","plus",v.text,fixed=T,useByte=T)
v.title<-gsub("#","sharp",v.title, fixed=T,useByte=T)
v.title<-gsub("+","plus",v.title,fixed=T,useByte=T)


N<-length(v.title)

findterm<-function(str)
{
  i<-(1:length(v.corr$X))[v.corr$X==str]
  u<-v.corr[i,-1]
  j<-rev(order(u))
  data.frame(tag.name=v.corr[i,1],term=t(names(u[j[1:4]])), corr=unname(u[j[1:4]]))
}


findterm2<-function(str)
{
  u<-v.corr2[i,-1]
  j<-which.max(u)
  data.frame(tag.name=v.corr2[i,1],u[j[1:5]])
}

#Compute correlation of ith tag with dtm_text2
h <- function(i)
{
  re0 <-  paste("\\Q",tag.names[i],"\\E",sep="")
  re1 <-  paste("^",re0," | ",re0," | ",re0,"$","|^",re0,"$",sep="")
  ind.actual <- grep(re1, df_sample$Tags, perl=T, useBytes=T)
  v <- rep(0, N)
  if(length(ind.actual)==0) return(list(rep(0,dim(dtm.text2)[2]),i, tag.names[i]))
  v[ind.actual] <- 1
  list(cor(dtm.text2, v), i, tag.names[i])
}

h2 <- function(i)
{
  re0 <-  paste("\\Q",tag.names[i],"\\E",sep="")
  re1 <-  paste("^",re0," | ",re0," | ",re0,"$","|^",re0,"$",sep="")
  ind.actual <- grep(re1, df_sample$Tags, perl=T, useBytes=T)
  v <- rep(0, N)
  if(length(ind.actual)==0) return(list(rep(0,dim(dtm.title2)[2]),i, tag.names[i]))
  v[ind.actual] <- 1
  list(cor(dtm.title2, v), i, tag.names[i])
}

stats<-function(act, pred)
{
  tp<-length(intersect(act, pred))
  a1<-tp/length(act)
  a2<-tp/length(pred)
  F<-2*a1*a2/(a1+a2)
  c(a1, a2, F)
}

testmodel<-function(tag, term, titleonly)
{
  i<-(1:length(tag.names))[tag.names==tag]
  re0 <-  paste("\\Q",tag.names[i],"\\E",sep="")
  re1 <-  paste("^",re0," | ",re0," | ",re0,"$","|^",re0,"$",sep="")
  ind.act <- grep(re1, df_sample$Tags, perl=T, useBytes=T)
  if (titleonly) ind.pred<-grep(term, v.title, perl=T, useBytes=T) else ind.pred<-grep(term, v.text, perl=T, useBytes=T)
  stats(ind.act, ind.pred)
}


find.model<-function(i)
 {
   print(i);
   re0 <-  paste("\\Q",tag.names[i],"\\E",sep="")
   re1 <-  paste("^",re0," | ",re0," | ",re0,"$","|^",re0,"$",sep="")
   ind.act <- grep(re1, df_sample$Tags, perl=T, useBytes=T)
   u<-h(i)[[1]]
   x<-gsub("-",".",tag.names[i],perl=T)
   x<-gsub("\\#","sharp",x, perl=T)
   x<-gsub("\\+","plus",x,perl=T)
   body_predictors<-u[rev(order(u)),][1:3]
   body_predictors<-c(names(body_predictors), x )
   u<-h2(i)[[1]]
   title_predictors<-u[rev(order(u)),][1:3]
   title_predictors<-c(names(title_predictors), x)
   a <- vector("list",4)
   a <- lapply(1:4, function(i) a[[i]] <- c(0,1))
   comb<-expand.grid(a)
   v.regex<-rep(NA, nrow(comb))

   for(j in 1:nrow(comb))
     v.regex[j]<-paste(body_predictors[unlist(comb[j,])>0],collapse="|")
   v.regex<- v.regex[v.regex!=""]
   fstat<-rep(NA, length(v.regex))

   for(k in 1:length(v.regex))
   {
     ind.pred<-grep(v.regex[k], v.text, perl=T, useBytes=T)
     fstat[k]<-stats(ind.act, ind.pred)[3]
   }
   m<-which.max(fstat)
   body.model<-v.regex[m];

   for(j in 1:nrow(comb))
     v.regex[j]<-paste(title_predictors[unlist(comb[j,])>0],collapse="|")
   v.regex<- v.regex[v.regex!=""]
   for(k in 1:length(v.regex))
   {
     ind.pred<-grep(v.regex[k], v.title, perl=T, useBytes=T)
     fstat[k]<-stats(ind.act, ind.pred)[3]
   }
   m<-which.max(fstat)
   title.model<-v.regex[m]
   list(i=i,tag.name=tag.names[i],title.model=title.model, body.model=body.model)
 }

more.tags<-read.csv("more_tags.csv",stringsAsFactors=F,header=F)

ans<-list()
for(i in 0:9)
ans<-c(ans,mclapply(v[(32*i+1):(32*i+32)],function(x)find.model((1:length(tag.names))[tag.names==x]), mc.cores=32))

ans<-mclapply(1:4000, find.model, mc.cores=16)







df<-as.data.frame(ans[[1]], stringsAsFactors=F)
for(i in 2:320) df<-rbind(df, ans[[i]])





u<-h(j)[[1]]
body_predictors<-u[rev(order(u)),][1:10]
u<-h2(j)[[1]]
title_predictors<-u[rev(order(u)),][1:10]


f <- function(i)
{
  ##Start with the grep model
  re0  <-  paste("\\Q",tag.map$tag[i],"\\E",sep="")
  re1 <-  paste("^",re0," | ",re0," | ",re0,"$","|^",re0,"$",sep="")
  re2 <- tag.map$regexp[i]
  ind.pred <- grep(re2, v.text, perl=T, useBytes=T)
  ind.actual <- grep(re1, df_sample$Tags, perl=T, useBytes=T)

  if (length(ind.actual)>0)
    sensitivity <- length(intersect(ind.pred, ind.actual))/length(ind.actual)  else sensitivity <- 0

  if(length(ind.pred)>0)
    specificity <- length(intersect(ind.pred, ind.actual))/length(ind.pred)  else specificity <- 0

  if (sensitivity+specificity > 0) f1stat <-  2*sensitivity*specificity/(sensitivity+specificity) else f1stat <- 0
  pred.type="grep"
  model.coef=""
  threshold=NA

  #Try a model grepping on only the title of the post
  if(TRUE)
  {
      ind.pred3 <- grep(re2, v.title, perl=T, useBytes=T)
      if (length(ind.actual)>0)
        sensitivity3 <- length(intersect(ind.pred3, ind.actual))/length(ind.actual)  else sensitivity3 <- 0

      if(length(ind.pred3)>0)
        specificity3 <- length(intersect(ind.pred3, ind.actual))/length(ind.pred3)  else specificity3 <- 0

      if (sensitivity3+specificity3 > 0) f1stat3 <-  2*sensitivity3*specificity3/(sensitivity3+specificity3) else f1stat3 <- 0

      if(f1stat3>f1stat)
      {
            f1stat = f1stat3
            sensitivity = sensitivity3
            specificity = specificity3
            ind.pred <-  ind.pred3
            pred.type="grep title"
            model.coef=""
      }
   }

  if (FALSE)
  {
    my.response<-rep(0,nrow(df_sample))
    my.response[ind.actual]<-1
    term<-names(which.max(v.corr[tag.map$tag[i],]))
    ind<-dtm.text2[,term]>0
    ind.pred3<-(1:length(ind))[ind]
    if (length(ind.actual)>0)
        sensitivity3 <- length(intersect(ind.pred3, ind.actual))/length(ind.actual)  else sensitivity3 <- 0

      if(length(ind.pred3)>0)
        specificity3 <- length(intersect(ind.pred3, ind.actual))/length(ind.pred3)  else specificity3 <- 0

      if (sensitivity3+specificity3 > 0) f1stat3 <-  2*sensitivity3*specificity3/(sensitivity3+specificity3) else f1stat3 <- 0

      if(f1stat3>f1stat)
      {
            f1stat = f1stat3
            sensitivity = sensitivity3
            specificity = specificity3
            ind.pred <-  ind.pred3
            pred.type="tag"
            model.coef=""
      }
  }

  if (FALSE)
  {
    term<-names(which.max(v.corr2[tag.map$tag[i],]))
    ind<-dtm.title2[,term]>0
    ind.pred3<-(1:length(ind))[ind]
    if (length(ind.actual)>0)
        sensitivity3 <- length(intersect(ind.pred3, ind.actual))/length(ind.actual)  else sensitivity <- 0

      if(length(ind.pred3)>0)
        specificity3 <- length(intersect(ind.pred3, ind.actual))/length(ind.pred3)  else specificity3 <- 0

      if (sensitivity3+specificity3 > 0) f1stat3 <-  2*sensitivity3*specificity3/(sensitivity3+specificity3) else f1stat3 <- 0

      if(f1stat3>f1stat)
      {
            f1stat = f1stat3
            sensitivity = sensitivity3
            specificity = specificity3
            ind.pred <-  ind.pred3
            pred.type="tag title"
            model.coef=""
      }
  }

  cat(i, tag.names[i],sensitivity, specificity, f1stat, pred.type, "\n")

  list(res.tagnum=i, res.sens=sensitivity, res.spec=specificity, res.f1=f1stat,
       pred.type=pred.type, model.coeff=model.coef, threshold=threshold ,flag.predicted=ind.pred)
}

b<-mclapply(1:num.tags, f, mc.cores=2)

sens <- sapply(1:length(b), function(i) b[[i]]$res.sens)
spec <- sapply(1:length(b), function(i) b[[i]]$res.spec)
f1stat <- sapply(1:length(b), function(i) b[[i]]$res.f1)
pred.type <- sapply(1:length(b), function(i) b[[i]]$pred.type)

perf.info <- data.frame(tag=tag.map$tag,tag.map$regexp,sens=sens, spec=spec, f1stat=f1stat, pred.type=pred.type)
write.csv(perf.info, "perf_info.csv")

predictions <- rep("", nrow(df_sample))
for(i in 1:length(b))
{
  ind <- b[[i]]$flag.predicted
  predictions[ind] <- paste(predictions[ind],tag.map$tag[i])
}

predictions <- substring(predictions, 2)

num.to.keep <- function(p)
{
  a <- vector("list",length(p))
  a <- lapply(1:length(a), function(i) a[[i]] <- c(0,1))
  outcomes <- expand.grid(a)
  prob.outcome <- sapply(1:nrow(outcomes),function(i)prod(p[unlist(outcomes[i,]>0)])*prod(1-p[unlist(outcomes[i,]==0)]))
  Ef <- rep(NA, length(p))
  for(j in 1:length(p))
  {
    a.try <- rep(0, length(p))
    a.try[1:j] <- 1
    tp <- as.matrix(outcomes)%*%a.try
    prec <- tp/j
    rec <- tp/apply(outcomes, 1, sum)
    f <- 2*prec*rec/(prec+rec)
    f[is.na(f)] <- 0
    Ef[j] <- sum(f*prob.outcome)
  }
  if(max(Ef)<.05) 0
  else which.max(Ef)
}

##Now predictions must be ordered by specificity and only the most powerful ones retained

g <- function(i)
{
  print(i)
  if(predictions[i]=="") return("")
  v_pred <- unlist(strsplit(predictions[i]," "))
  v_spec <- sapply(1:length(v_pred),function(j)perf.info$spec[perf.info$tag==v_pred[j]])
  v_pred <- v_pred[rev(order(v_spec))]
  v_spec <- v_spec[rev(order(v_spec))]
  if (length(v_pred)>5)
  {
    v_pred <- v_pred[1:5]
    v_spec <- v_spec[1:5]
  }
  n <- num.to.keep(v_spec)
  cat(length(v_pred), " predictions, keeping ", n, "\n")
  if (n==0) ""  else   paste(v_pred[1:n],collapse=" ")
}


ans <- mclapply(1:length(predictions), g, mc.cores=3)


predictions[predictions==""] <- "c# java javascript c++"

F1 <- function(pred,actual)
{
	tp <- sum(sapply(1:length(pred), function(n) max(actual == pred[n])))
	if(tp == 0) return(0)
	prec <- tp/length(pred)
	recall <- tp/length(actual)
	2*prec*recall/(prec + recall)
}


mean(sapply(1:length(predictions), function (n) F1(unlist(strsplit(predictions[n],split=" ")),
                                                  unlist(strsplit(df_sample$Tags[n], split=" ")))))

#0.408686

dump("b")


##Logistic model - not used for now
if (FALSE){
    ##Now try a logistic model for low F1 stat
    my.response<-rep(0,nrow(df_sample))
    my.response[ind.actual]<-1
    m.correlations<-cor(dtm2, my.response)
    v.correlations<-as.vector(m.correlations)
    names(v.correlations)<-row.names(m.correlations)
                                        #  a<-v.correlations[rev(order(v.correlations))][1:10]
    a<-v.correlations[rev(order(abs(v.correlations)))][1:10]
    df<- data.frame(dtm2[,names(a)],my.response)
    m<-glm(my.response~., data=df, family=binomial)
    probs<-predict(m,type="resp")
    x1<-sapply(seq(.01,1,.01), sensitivity2, probs, my.response)
    x2<-sapply(seq(.01,1,.01), specificity2, probs, my.response)
    F<-2*x1*x2/(x1+x2)
    F[is.na(F)]<-0
    j<-which.max(F)
    threshold<-(seq(.01,1,.01))[j]
    if(max(F)>f1stat)
      {
        f1stat = max(F);
        sensitivity = x1[j]
        specificity = x2[j]
        ind.pred<- (1:length(probs))[probs > seq(.01,1,.01)[j]]
        pred.type="model"
        model.coef=m$coeff
      }
 }
